Disclaimer: This is a draft example of displaying a period of record for monitoring wells at the Yellowstone wetland. A seperate python script compiles all data for the site into one large csv file, which is the base data for this script.
library(tidyverse)
library(readxl)
library(glue)
library(plotly)
library(scales)
library(htmltools)
library(here)
library(knitr)
wellData <- read_csv("All_well_data_combined_YELL.csv",
col_types = cols(`Barometric Pressure (PSI)` = col_skip(),
`Date and Time` = col_datetime(format = "%m/%d/%Y %H:%M:%S %p"),
`Depth (ft)` = col_skip(),
Seconds = col_skip(),
`Temperature (C)` = col_skip(),
`Unnamed: 5` = col_skip(),
`Unnamed: 6` = col_skip()))
# Rename the fields
names(wellData) <- c('DateTime', 'PSI', 'Well' )
# Format the date field
wellData$Date <- format(wellData$DateTime, "%m-%d-%Y")
wellData$Date<- as.Date(wellData$Date, format="%m-%d-%Y")
# Take a peek at the data
glimpse(wellData)
## Observations: 48,678
## Variables: 4
## $ DateTime <dttm> 2011-09-29 00:00:00, 2011-09-29 06:00:00, 2011-09-29...
## $ PSI <dbl> -0.002, -0.004, 0.000, 0.060, -0.325, -0.322, 0.155, ...
## $ Well <chr> "NR-BD161", "NR-BD161", "NR-BD161", "NR-BD161", "NR-B...
## $ Date <date> 2011-09-29, 2011-09-29, 2011-09-29, 2011-09-29, 2011...
# Get the stats for each well needed to perform the calculations
well_stats <- read_excel("Well Stats_NorthernRange.xlsx")
# Show the well stats
kable(well_stats,
caption = "tow = Top of well elevation (meters),
toc = Top of well casing to sensor,
dgs = Design ground surface,
fbgs = 1ft below ground surface")
| Well | tow | toc | dgs | fbgs |
|---|---|---|---|---|
| NR-BD161 | 0.33 | 1.927 | 0 | -0.3 |
| NR-BM305 | 0.30 | 1.901 | 0 | -0.3 |
| NR-DC003 | 0.28 | 1.865 | 0 | -0.3 |
| NR-LT203 | 0.37 | 1.495 | 0 | -0.3 |
# Function to extract stats from the well stats table
get_stat <- function(stat, wellName){
return_stat <- well_stats %>%
filter(Well == !!wellName) %>%
pull(stat)
return(return_stat)
}
# Graphing function accepting well name as the parameter
make_graph <- function(well){
# Pull stats into variables based on well name
tow <- get_stat("tow", well)
toc <- get_stat("toc", well)
dgs <- get_stat("dgs", well)
fbgs <- get_stat("fbgs", well)
# Select just the well needed, and perform the calculations into new fields
wellSelect <- wellData %>%
filter(Well == well) %>%
mutate(WaterTableElevM = tow-toc+PSI*0.703772,
GroundSurfaceElev = dgs,
FtBelowGS = fbgs)
# Narrow down the min and max dates
earliest <- min(wellSelect$Date)
latest <- max(wellSelect$Date)
# Prepare precip data
# Source: http://climateanalyzer.science/python/u_thresh.py?station=santa_cruz_raws&year1=2011&year2=2019&title=Santa%20Cruz%20Island%20automated%20station&lowerthresh=daily&upperthresh=70&station_type=RAWS
# precip <- read_csv("santa_cruz_raws_thresholds.csv",
# col_types = cols(`Avg. Relative Humidity (%)` = col_skip(),
# `Avg. Wind Speed (MPH)` = col_skip(),
# Date = col_date(format = "%m/%d/%Y"),
# `Tmax (F)` = col_skip(),
# `Tmin (F)` = col_skip(),
# X7 = col_skip()))
#
# # Rename precip fields
# names(precip) <- c('Date', 'Precip')
# # Make the date field a date type
# precip$Date <- as.POSIXct(precip$Date)
# Trim to min/max dates pulled in from the well data
# precip <- precip %>%
# filter(Date > earliest & Date < latest)
# Make graph to match Joel's excel graph
p <- ggplot(wellSelect, aes(x = DateTime)) +
geom_line(aes(y=WaterTableElevM, colour = "WaterTableElevM"), size=.5, alpha=0.6) +
geom_line(aes(y=GroundSurfaceElev, colour = "GroundSurfaceElev"), size=.6, alpha=0.6, ) +
geom_line(aes(y=FtBelowGS, colour = "FtBelowGS"), size=.6, alpha=0.6, linetype = "longdash") +
# scale_x_date(date_breaks = "2 month", date_labels = "%b %Y") +
scale_x_datetime(labels = date_format("%Y-%m-%d"),
date_breaks = "730 hours") +
theme(axis.text.x=element_text(angle=60, hjust=1), legend.position="bottom") +
ggtitle(glue("Yellowstone Wetland Well {well} Readings {earliest} to {latest}"),
subtitle = "Height of water above sensor (meters)") +
xlab("Date and Time") +
ylab("Meters above Sensor") +
scale_colour_manual("", values = c("WaterTableElevM"="black", "GroundSurfaceElev"="darkgreen", "FtBelowGS"="blue")) +
# geom_bar(data=precip, aes(x=Date, y=Precip), stat="identity", fill="tan1", colour="sienna3") +
scale_y_continuous( "meters", sec.axis = sec_axis(~ . * 1, name = "inches"))
# Plot the graph
ggplotly(p)
}
unique(wellData$Well)
## [1] "NR-BD161" "NR-BM305" "NR-DC003" "NR-LT203"
# wellList <- c("PH6", "PH7", "PH9", "PH16", "PH19", "PH20", "PH21", "PH22", "PH23")
wellList <- c("NR-BD161","NR-BM305" ,"NR-DC003" ,"NR-LT203")
# Generate a graph for each well name
all_plots <- lapply(wellList, make_graph)
htmltools::tagList(all_plots)